home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Library / Manuels & Misc / Assembly / AOA.ZIP / CH25 / IMAGEPRC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-04  |  3.3 KB  |  102 lines
  1. program PhotoFilter(input,output);
  2.  
  3. (* Here is the raw file data type produced by the Photoshop program *)
  4.  
  5. type
  6.     image = array [0..250] of array [0..255] of byte;
  7.  
  8. (* The variables we will use.  Note that the "datain" and "dataout"     *)
  9. (* variables are pointers because Turbo Pascal will not allow us to     *)
  10. (* allocate more than 64K data in the one global data segment it        *)
  11. (* supports.                                                            *)
  12.  
  13. var
  14.     h,i,j,k,l,sum,iterations:integer;
  15.     datain, dataout: ^image;
  16.     f,g:file of image;
  17.  
  18. begin
  19.  
  20.      (* Open the files and real the input data  *)
  21.  
  22.      assign(f, 'roller1.raw');
  23.      assign(g, 'roller2.raw');
  24.      reset(f);
  25.      rewrite(g);
  26.      new(datain);
  27.      new(dataout);
  28.      read(f,datain^);
  29.  
  30.      (* Get the number of iterations from the user *)
  31.  
  32.      write('Enter number of iterations:');
  33.      readln(iterations);
  34.  
  35.      writeln('Computing result');
  36.  
  37.      (* Copy the data from the input array to the output array. *)
  38.      (* This is a really lame way to copy the border from the   *)
  39.      (* input array to the output array.                        *)
  40.  
  41.      for i := 0 to 250 do
  42.          for j := 0 to 255 do
  43.              dataout^ [i][j] := datain^ [i][j];
  44.  
  45.      (* Okay, here's where all the work takes place.  The out-  *)
  46.      (* side loop repeats this blurring operation the number of *)
  47.      (* iterations specified by the user.                       *)
  48.  
  49.      for h := 1 to iterations do begin
  50.  
  51.        (* For each row except the first and the last, compute   *)
  52.        (* a new value for each element.                         *)
  53.  
  54.        for i := 1 to 249 do
  55.  
  56.          (* For each column except the first and the last, com- *)
  57.          (* pute a new value for each element.                  *)
  58.  
  59.          for j := 1 to 254 do begin
  60.  
  61.              (* For each element in the array, compute a new    *)
  62.              (* blurred value by adding up the eight cells      *)
  63.              (* around an array element along with eight times  *)
  64.              (* the current cell's value.  Then divide this by  *)
  65.              (* sixteen to compute a weighted average of the    *)
  66.              (* nine cells forming a square around the current  *)
  67.              (* cell.  The current cell has a 50% weighting,    *)
  68.              (* the other eight cells around the current cell   *)
  69.              (* provide the other 50% weighting (6.25% each).   *)
  70.  
  71.              sum := 0;
  72.              for k := -1 to 1 do
  73.                  for l := -1 to 1 do
  74.                      sum := sum + datain^ [i+k][j+l];
  75.  
  76.              (* Sum currently contains the sum of the nine      *)
  77.              (* cells, add in seven times the current cell so   *)
  78.              (* we get a total of eight times the current cell. *)
  79.  
  80.              dataout^ [i][j] := (sum + datain^ [i][j]*7) div 16;
  81.  
  82.          end;
  83.  
  84.        (* Copy the output cell values back to the input cells   *)
  85.        (* so we can perform the blurring on this new data on    *)
  86.        (* the next iteration.                                   *)
  87.  
  88.        for i := 0 to 250 do
  89.            for j := 0 to 255 do
  90.                datain^ [i][j] := dataout^ [i][j];
  91.  
  92.      end;
  93.  
  94.      writeln('Writing result');
  95.      write(g,dataout^);
  96.      close(f);
  97.      close(g);
  98.  
  99. end.
  100.  
  101.  
  102.